perm filename MS.F4[NEW,LCS]6 blob sn#517364 filedate 1980-06-19 generic text, type T, neo UTF8
00100	COMMENT ⊗   VALID 00004 PAGES
00200	C REC  PAGE   DESCRIPTION
00300	C00001 00001
00400	C00002 00002	C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00500	C00032 00003
00600	C00050 00004	1860	J2=R2
00700	C00067 ENDMK
00800	C⊗;
     

00100	C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200	C *** READS DATA FROM CLEFA-B-C-ETC., BDR40,BDI40, ETC.
00300	
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
00600		DIMENSION LST(18),DP(0/7)
00700		COMMON /DL/X22,SAVER,NAME,EXT,IOLD /RRJJ/RJJ2,RJJ(20),JJA
00800		1 /FONT/JFONT /RINP/R(10,80),RPOS(2,50),RI(200) 
00900		2 /RMOD/RMODE2,RSET4,IBEAM,
01000		3 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
01100		4 /FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
01200	C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
01300		COMMON  /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
01400		1 /STF/RSTFAC(0/7),RSTJ2
01500		2  /POSI/STFF(0/7),JJ2,POS  /ALF/INP(72),ML 
01600		3 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01700		4 /UPDWN/ RL,UD /IDEV/IDEV /NUM/NUM(10),JRD
01800		5 /PLTR/PLT,RHT,DIS,XDIS /PTR/PWDS(350)
01900	CC      COMMON /PLTR/PLT,RHT,DIS,XDIS/PTR/PWDS(250),ITEM,L,I,IX
02000		COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
02100		1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
02200		2 /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM 
02300		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW /MKS/MKS(14)
02400		1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO  /DPTR/WDS(350)
02500		2 /MKX/MKX(11) /SC/SSC(72) /YED/YED,IBOX,RBOX/JCLIP/JCLIP
02600	CC      COMMON/XRN/RN(2500)/DPY/ST(4000),WDS(250),MEDIT,IGO
02700		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(I4,
02800		1 INP(4)),(R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,
02900		2 RJQ(5)),(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(I3,INP(3)),
03000		3 (RJ13,RJJ(11))
03100		4,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1)),(R9,
03200		5 RJQ(7)),(RX3,RJQ(20)),(ST2,ST(2)),(R13,RJQ(11)),(J8,JQ(6))
03300		6 ,(J13,JQ(11)),(IPOS,POS),(LST(13),K),(LST(14),X),(LST(15),J)
03400		7 ,(I7,INP(7)) ,(ISTAR,MKX(11))
03500		1 ,(MINUS,MKX(10)),(LESS,MKX(3)),(IGT,MKX(4)),(RJ7,RJJ(5))
03600		DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/,ILIM/350/
03700		1 ,STFF/-469.,-346.,-223.,-100.,23.,146.,269.,392./,RSTFAC/8*1./
03800		2 ,LST/'NOTE','REST','CLEF','LINE','SLUR','BEAM','TRILL','STAFF',
03900		3 'MISC','NUMB','LIBRY','CIRCL',0,0,0,'WORD','KSIG','METER'/
04000		4 ,DP/8*1/,RNW/2.44/,LCNT/1/,LIMIT/3000/,DIS/1.0/, RHT/1.0/
04100		5 ,PLUS/'+'/,EXT/'MS '/,COMMA/','/
04200		DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
04300	C THE GIANT NUMBERS ARE FOR [ AND ]
04400		DATA MKX/'/',';','<','>',-19728949184,-18655207360,'(',')','.'
04500		1,'-','*'/,SSC(14)/'X'/,SSC(15)/';'/,SSC(72)/' '/
04600	C LIMIT IS MAIN ARRAY LENGTH (3000)   /SC/SSC ARRAY USED IN MARKS,BEAMS,SLURS
04700	C  350 LIM. ON ITEMS PWDS, WDS (SEE ALSO 571 TO 170)
04800	
04900	C*****  CALL SEGFIX C FOR UPPER SEGMENTS USED BY MORE THAN 1 JOB (SEGFIX.FAI[TVR])
05000		LCEN=0
05100		MCEN=0
05200		IDEV=5
05300		I1=0
05400		CALL TYPLOC(450,200)
05500	10	CALL DPYX
05600	C THIS DOES DPYSET, ETC.
05700		DO 20 K=1,I
05800	CLEARS ARRAY FOR RESTART OF 'SETUP' ROUTINE
05900	20	RN(K)=0
06000		JFONT=0
06100		CHNG=0
06200	C flag for edit changes (=-1 means a change has been made.)
06300		IOLD=0
06400	C   IOLD HOLDS LAST ITEM NUM. EDITED.
06500		IX=0
06600		RSET4=999
06700		QUICK=0
06800		CB=0
06900	C CB IS CENTER-BIG (CENTERING RANGE=6)
07000		UD=1
07100		RL=1
07200		FSCN=LEL
07300		RPOS(1,1)=0
07400		RSZ=.845
07500		JCLIP=525
07600		X22=0
07700		MINUZ=0
07800	C MINUZ IS FLAG FOR '-' SETTING CRLF BACKUP FEATURE (WHEN IN EDIT MODE)
07900		JCEN=0
08000		KCEN=0
08100		PLT=0
08200		PWDS(1)=1
08300		EDQ=-1
08400		RN(2)=0
08500	C  FOR RESTART.  AVOIDS STAFF CODE NUM.
08600		SAVER=4
08700		DO 30 K=0,7
08800	30	RSTFAC(K)=1.
08900		REDIT=999.
09000		M=1
09100		ITEM=0
09200		ITEMX=0
09300		ZERO=-1
09400		WDS(1)=4
09500	C  DATA IN DPY ARRAY STARTS AT WD.4!
09600		I=1
09700	40	SCORE=-1
09800	50	IGO=-1
09900		IF(I1.NE.LRR)GO TO 130
10000		I1=-1
10100		CALL NAMEXT(INP,NAME,EXT)
10200		J2=0
10300		IF(NAME.NE.IBLA)GO TO 2250
10400	C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
10500		GO TO 130
10600	
10700	60	CALL NOTWRT
10800	70	IF(M.GT.I)GO TO 80
10900	CC	IF(IGO)CALL DPYOUT(1)
11000	        IF(IGO)CALL DPYDO(1)
11100	80	ITEM=ITEM+1
11200		IF(ITEM.LT.ILIM)GO TO 90
11300		CALL TYPSTR('**** TOO MANY ITEMS')
11400		CALL TYPINT(ITEM)
11500		CALL TYPSTR('/349')
11600		CALL TYPCRLF
11700		I=PWDS(ILIM)
11800		ITEM=ILIM-1
11900		ST2=WDS(ILIM)
12000	CC	CALL DPYOUT(1)
12100	        CALL DPYDO(1)
12200		GO TO 40
12300	90	IF(IGO.GT.0)GO TO 100
12400		K=ST2
12500		IF(X22.EQ.0)GO TO 100
12600		CALL BOX(IBOX,RBOX)
12700		ST2=K
12800	100	WDS(ITEM+1)=ST2
12900		IF(EDQ.EQ.-1)GO TO 110
13000		IF(M.LT.I)GO TO 2370
13100	C  SL=SAVE AFTER RESETTING LENGTH OF PAGE.  (SEE I2 IN SCX)
13200	110	PWDS(ITEM+1)=I
13300		PLT=0
13400		IF(IGO.NE.0)GO TO 120
13500	CC	CALL DPYOUT(1)
13600	        CALL DPYDO(1)
13700		IF(SCORE.EQ.0)GO TO 1000
13800	C  GO GET MORE FROM SCX.
13900		IGO=-1
14000	
14100	120	IF(SCORE.EQ.0)GO TO 1070
14200	130	SVST=ST2
14300	C CATCHES TYPO WITH 'C'
14400		K=ITEM+1
14500		IF(X22.EQ.0)GO TO 250
14600	C 'N' SUPPRESSES TYPE-OUT, 'P' OR NEW ITEM RESTORES IT.
14700		IF(QUICK)170,140,290
14800	C -1=QUICK MODE, +1=SUPPRESS TYPE-OUT OF PARAMS, 2=AS 1, BUT RESETS AT C
14900	140	L=RN(MEDIT+1)
15000		K=X22
15100	CXX	IF(IDEV.EQ.1)GO TO 250
15200		IF(IDEV.EQ.1)GO TO 290
15300	C 'FILE'CAN BE USED  WHILE IN EDIT MODE
15400		CALL TYPCRL
15500		CALL TYPWRD(LST(L))
15600		CALL TYPCRL
15700		CALL TYPFLT(RN(MEDIT+1))
15800		CALL TYPCHR('   ',3)
15900		CALL TYPFLT(RN(MEDIT+2))
16000		CALL TYPCHR('   ',3)
16100		CALL TYPFLT(RN(MEDIT+3))
16200		IF(YED.LT.2)GO TO 260
16300	C   YED IS SET AT 426
16400		DO 150 L=4,YED+2
16500		CALL TYPCHR('   (',4)
16600		CALL TYPINT(L)
16700		CALL TYPCHR(') ',2)
16800	150	CALL TYPFLT(RN(MEDIT+L))
16900		CALL TYPCRL
17000		GO TO 260
17100	
17200	160	  IF(X22.EQ.0)GO TO 260
17300		QUICK=-1
17400		CALL TYPSTR(';=LFT :=RT (=UP )=DN /=HALF *=*2')
17500		CALL TYPCRL
17600	170	CALL FSCAN
17700	C FNUM.FAI=FAST COMMANDS ;=← :=→ (=↑ )= /=HALF *=*2 X=X C=C OTHERS=CR
17800		GO TO 380
17900		GO TO 400
18000		GO TO 410
18100		GO TO 420
18200		GO TO 450
18300		GO TO 470
18400		GO TO 430
18500		GO TO 440
18600		I1=0
18700	180	QUICK=0
18800		GO TO 330
18900	
19000	190	FORMAT(2A5)
19100	200	REREAD 190,K,K
19200		IF(I4.NE.LPP)GO TO 210
19300		CALL HELP(K)
19400		GO TO 130
19500	210	CALL LO2UP(K)
19600	C CHANGES LOWER CASE TO UPPER CASE
19700		IF(K.NE.IBLA)GO TO 215
19800		K=FILNAM
19900		CALL TYPSTR('READING ')
20000		CALL TYPWRD(K)
20100		CALL TYPCRL
20200	215	FILNAM=K
20300	C SAVE NAME FOR LATER USE. 'READ' OR 'RR' ALONE READS PREVIOUS FILE.
20400		IF(LOOK(K)+LOOKD(K))GO TO 220
20500		CALL TYPSTR(' FILE NOT FOUND')
20600		GO TO 260
20700	CC2502  CALL IFILE(1,K)
20800	220	CALL FILX(K)
20900	C  GOBBLES ET HEADER OR CONVERTS SOS FILE
21000	230	IDEV=1
21100		GO TO 290
21200	
21300	240	IDEV=5
21400		GO TO 260
21500	C RESET TO TTY MODE
21600	
21700	250	CALL HYDPOG(3)
21800	C  TO DELETE VERTICAL LINE (55)
21900		KED=0
22000		QUICK=0
22100	C  RESET PARAM TYPE-OUT
22200		RJ13=0
22300	C KILL CENTERING FEATURE FOR NOW
22400	260	IF(IDEV.EQ.1)GO TO 290
22500		CALL TYPCRL
22600		IF(X22.EQ.0)GO TO 270
22700		CALL TYPSTR('**** EDIT ITEM #')
22800		CALL TYPINT(K)
22900		GO TO 280
23000	270	CALL TYPWRD(NAME)
23100		CALL TYPCHR('.',1)
23200		CALL TYPWRD(EXT)
23300		CALL TYPSTR('   TYPE FOR ITEM #')
23400		CALL TYPINT(K)
23500		CALL TYPSTR('           ')
23600		CALL TYPINT(I)
23700		CALL TYPSTR(' ')
23800		CALL TYPINT(SVST)
23900	280	CALL TYPCRL
24000	290	SCORE=-1
24100	CQQ     ACCEPT 89,INP
24200		READ(IDEV,700,END=240)INP
24300		CALL LULOOP
24400		IF(I1.EQ.LESS)GO TO 240
24500	C  '<' = TEMPORARY ESCAPE FROM 'FILE' MODE
24600		IF(I1.NE.IGT)GO TO 300
24700		IF(X22.NE.0)GO TO 260
24800	C  '>' = RETURN TO 'FILE' MODE - IF NOT STILL EDITING.
24900		GO TO 230
25000	300	IF(IDEV.EQ.5)GO TO 320
25100		IF(I7.NE.LTT)GO TO 320
25200		IF(I1.NE.LCC)GO TO 320
25300	C 'ET' DIRECTORY? UGH!!!
25400	310	READ(IDEV,700)INP
25500		IF(I3.NE.ISEMI)GO TO 310
25600		READ(IDEV,700)INP
25700	C READ AGAIN TO GET PAGE MARK - OR SOMETHING???
25800		GO TO 290
25900	C****320	REREAD 2430,J,R2,RJQ
26000	C  ↑↑↑ 1/78
26100	320	CALL READX
26200	CRR	J=JA
26300	C  FIRST CATCHES BLANKS, NUMBERS, ETC.
26400	330	IF(I1.GT.COMMA)GO TO 900
26500		IF(I1.EQ.IBLA)GO TO 900
26600		IF(I1.EQ.LII)GO TO 740
26700	C  I = IN, ITEM
26800		IF(I1.EQ.IXX)GO TO 640
26900	C  X = EXIT
27000		IF(I1.EQ.LEL)GO TO 680
27100	C  L = LEFT, LP=LIGHT PEN
27200		IF(I1.EQ.LUU)GO TO 680
27300	C  U = UP
27400		IF(I1.EQ.LRR)GO TO 660
27500	C  R = RIGHT, RI=RIT, READ, RS=RESTART
27600		IF(I1.EQ.LDD)GO TO 360
27700	C  D = DOWN, DI=DIM, DE=DELETE
27800		IF(I1.EQ.LCC)GO TO 1740
27900	C  C = COPY, CR=CRESC., CN=CENTER, CB=CENTER BIG, CH=ON HEAD, CT=ON TAIL
28000	C  CX = UNCENTER  CP n =CENTER BY NOTE POSITION
28100		IF(I1.EQ.LSS)GO TO 490
28200	C  S = SAVE, SPACING STAFF, STAFF, SHOW, SF, SFZ, SCALE, STC=STACCATO
28300		IF(I1.EQ.LEE)GO TO 540
28400	C  E ED=EDIT WITH POS. FIRST, E=EDIT WITH LIGHT PEN, ES=EDIT WITH STAFF NUM
28500		IF(I1.EQ.LNN)GO TO 710
28600	C  N = NO TYPE
28700		IF(I1.EQ.LPP)GO TO 1150
28800	C  P = P,PP,PPP, P N=PRINT PARAM N., PR=PRINT PARAM LIST, POCO, PIU, PZ=PIZZ,
28900		IF(I1.EQ.LAA)GO TO 350
29000	C  A = ADJUST TO SET, AD=ADJUST STEMS, AC=ACCEL, AR=ARCO, AT=A TEMPO, ACT=ACCENT
29100		IF(I1.EQ.LQQ)GO TO 160
29200	C  Q = QUICK
29300		IF(I1.EQ.LTT)GO TO 770
29400	C  T = TYPE TEXT, T=TYPE OUT, TE=TENUTO, TL=TYPLOC
29500		IF(I1.EQ.LFF)GO TO 870
29600	C  F = F,FF,FFF,FE=FERMATA,FILE(TO READ COMMAND FILE)
29700		IF(I1.EQ.LHH)GO TO 840
29800	C  H = HARMONIC, HW=HEAVY WEDGE, HELP
29900		IF(I1.EQ.COMMA)GO TO 1460
30000	C VALUE OF COMMA IS > VALUE OF PLUS
30100		IF(I1.GE.PLUS)GO TO 900
30200		IF(X22.NE.0)GO TO 260
30300	C NEXT CANNOT HAPPEN IN EDIT MODE.
30400	C  O = O=ORDER BY STAFF, OX=ORDER WITHOUT REGARD FOR STAFF NUM.
30500		IF(I1.NE.LOH)GO TO 340
30600	C NEXT FOR REORDERING ITEMS FROM LEFT TO RIGHT, BY STAFF. THEN IT DOES A
30700		IF(I2.EQ.LXX)R2=1
30800		CALL ORDER
30900	340	IF(I1.EQ.LZZ)GO TO 1170
31000	C  Z = ZOOM
31100		IF(I1.EQ.LMM)GO TO 1770
31200	C  M = MOVE, ME=MENO, MO=MOLTO, MF,MP
31300		IF(I1.EQ.LJJ)GO TO 1770
31400	C  J = JUSTIFY   JT=JUSTIFY TEXT
31500		IF(I1.EQ.LGG)GO TO 2220
31600	C  G = GET, GM=GET MORE
31700		IF(I1.EQ.LWW)GO TO 850
31800	C  W = WEDGE ACCENT
31900		IF(I1.EQ.'(')GO TO 1430
32000		IF(I1.EQ.')')GO TO 1450
32100	C LEFT AND RIGHT PARENTHESES
32200		IF(I1.NE.LBB)GO TO 260
32300	C******* ADD MORE LETTER ITEMS HERE *************
32400	C  B = BRC=BRACE, BRK=BRACKET  -- FOR FRONT OF LINE.  BAR=BAR LINE.
32500		IF(X22.NE.0)GO TO 260
32600	CRR***	REREAD 2430,JA,JA,JA,R2,RJQ
32700	CRR***	J=4
32800		JA=4
32900		R7=5
33000		IF(I3.NE.LCC)R7=4
33100		IF(I3.EQ.LRR)R7=0
33200		GO TO 900
33300	
33400	350	IF(I2.EQ.LDD)GO TO 570
33500	C 'A'  = ALTER(GO TO 112) ADJUST(GO TO 886) ACCEL(GO TO 7813)
33600	C ALIGN=GO TO 886
33700		IF(X22.NE.0)GO TO 580
33800		IF(I2.EQ.LTT)GO TO 1410
33900	C AT=A TEMPO
34000		IF(I2.EQ.LRR)GO TO 1420
34100	C AR=ARCO
34200		IF(I2.NE.LCC)GO TO 1060
34300		IF(I3.EQ.LTT)GO TO 810
34400	C ACT=ACCENT.   NEXT FOR AC (=ACCEL.)
34500		RD=80
34600		GO TO 880
34700		
34800	360	IF(I2.GE.IBLA)GO TO 650
34900	C 'D'  DIM →578, DOWN →883, DELETE →112 OR 883  DP →886
35000		IF(I2.NE.LEE)GO TO 370
35100		IF(X22.NE.0)GO TO 650
35200		GO TO 1060
35300	370	IF(I2.EQ.LPP)GO TO 570
35400		IF(I2.NE.LII)GO TO 260
35500	C NEXT FOR DIM.=82
35600		IF(X22.NE.0)GO TO  260
35700		RD=82
35800		GO TO 880
35900	
36000	380	I1=LEL
36100	390	FSCN=I1
36200		GO TO 330
36300	400	I1=LRR
36400		GO TO 390
36500	410	I1=LUU
36600		GO TO 390
36700	420	I1=LDD
36800		GO TO 390
36900	430	I1=IXX
37000		GO TO 180
37100	440	I1=LCC
37200		GO TO 180
37300	450	I1=FSCN
37400		IF(FSCN.EQ.LEL)GO TO 460
37500		IF(FSCN.EQ.LRR)GO TO 460
37600	C NEXT FOR UP-DOWN
37700		UD=UD/2
37800		GO TO 330
37900	460	RL=RL/2
38000		GO TO 330
38100	470	I1=FSCN
38200		IF(I1.EQ.LEL)GO TO 480
38300		IF(I1.EQ.LRR)GO TO 480
38400		UD=UD*2
38500		GO TO 330
38600	480	RL=RL*2
38700		GO TO 330
38800	
38900	
39000	C  'S'=SET, SA=SAVE, SB=SAVE BIG, SM=BIG+SAME NAME, ST=STAFF, SP=SPC STF
39100	C  SC=SPACING SCALE ABOVE STAFF n (99=DELETE IT)
39200	490	IF(I2.EQ.LTT)GO TO 560
39300		IF(I2.EQ.LAA)GO TO 520
39400		IF(I2.EQ.LCC)GO TO 580
39500		IF(I2.EQ.LDD)GO TO 520
39600		IF(I2.EQ.LEE)GO TO 530
39700		IF(I2.EQ.IBLA)GO TO 530
39800		IF(I2.EQ.LPP)GO TO 730
39900		IF(I2.EQ.LHH)JFONT=1
40000		IF(I3.EQ.IXX)JFONT=0
40100		IF(I3.EQ.LPP)JFONT=-1
40200		IF(I3.EQ.LOH)JFONT=-2
40300		IF(I3.EQ.LII)JFONT=-3
40400	C  'SH'(=SHOW) IS SAME AS 44 1.  SHOWS TYPE FONTS ON DPY.
40500	C  'SHP' = SHOW ONLY AS 'PRIMITIVE' FONT, 'SHX' = CANCEL FONTS ON DPY.
40600	C  'SHO' = FONT SET (TEMPORARILY) TO 'BDR'; 'SHI' = 'BDI' (ITALICS)
40700		IF(I2.NE.LFF)GO TO 510
40800		RD=45
40900		IF(I3.NE.LZZ)GO TO 880
41000		RD=92
41100	CRR***500	REREAD 2430,JA,JA,JA,R2,RJQ
41200	500	R5=RD
41300		GO TO 890
41400	510	IF(I2.NE.LMM)GO TO 130
41500	C  ONLY FOR ST, SA, SB, SM, RS, S, SF=45, SFZ=92
41600	520	IF(X22.NE.0)GO TO 130
41700		SAVER=4
41800		CALL SAVIT
41900		GO TO 130
42000	530	JA=55
42100		R2=RN(MEDIT+3)
42200	C  POSITION OF ITEM LOOKED AT.
42300		R3=55.
42400		GO TO 1110
42500	C  ABOVE FOR 'S'ET ALIGNMENT
42600	C  'S'=SET ALIGNMENT, 'A'=ALIGN IT.  'M'=MOVER 'C'= COPIER
42700	C  'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;
42800	540	K=-1
42900		DO 550 JA=3,10
43000	550	IF(INP(JA).NE.IBLA)GO TO 570
43100		GO TO 650
43200	CRR***560	FORMAT(A2,21F)
43300	CC      IF(X22.NE.0)GO TO 59
43400	560	IF(I3.EQ.LCC)GO TO 830
43500	C STC=STACCATO
43600	570	IF(CHNG.NE.0)GO TO 130
43700	C CAN'T DO 'ST' AND OTHER THINGS AFTER CHANGES IN EDIT MODE.
43800	CRR***580	REREAD 560,K,R2,RJQ
43900	580	JA=55
44000		IF(I2.NE.LCC)GO TO 590
44100		CALL SCL
44200		GO TO 130
44300	590	IF(I2.NE.LDD)GO TO 600
44400		IF(I1.EQ.LAA)JA=190
44500	C  'AD'just stems to beams.  'A'=ADJUST LFT-RT POS. AFTER 'SET' COMMAND
44600	600	IF(I2.EQ.LTT)JA=44
44700		IF(I2.EQ.LNN)GO TO 950
44800		IF(I2.NE.LPP)GO TO 1110
44900		IF(R2.GT.7)GO TO 620
45000	C  GO BACK AND RESET ALL IF STF NUM >7
45100		K=R2
45200		JA=0
45300	C  USE '8' FOR STAFF 0.
45400		IF(K.GE.0)GO TO 610
45500	C TYPE DP -1  FOR ALL INVISIBLE
45600		DO 611 K=0,7
45700	611	DP(K)=-1
45800		GO TO 120
45900	610	IF(K.EQ.8)K=0
46000		DP(K)=-DP(K)
46100		JA=JA+1
46200		K=RJQ(JA)
46300		IF(K.EQ.0)GO TO 120
46400	C  JUMP OUT IF RJQ(JA)=0 OR 99
46500		IF(K.EQ.99)GO TO 1320
46600	C*** 3/74  END WITH '99' TO MAKE DP RIGHT NOW!
46700		GO TO 610
46800	620	DO 630 K=0,7
46900	630	DP(K)=1
47000		GO TO 1320
47100	C  TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
47200	
47300	C 'LP'=LIGHT PEN. TO BE USED ONLY IN EDIT MODE
47400	640	IF(X22.EQ.0)GO TO 260
47500	C 'X'  GO BACK IF NOT IN EDIT MODE  -- ALSO R,L,U,D
47600		MINUZ=0
47700	C  CLEAR MINUS SIGN FLAG
47800	
47900	C NEXT FOR READ, RS, DEL, L,R,U,D
48000	650	IF(IX.EQ.I)GO TO 670
48100	C  CAN'T DELETE ('DE') AFTER A PARAM HAS BEEN CHANGED. START OVER.
48200		IF(I2.NE.LEE)GO TO 680
48300		GO TO 130
48400	
48500	C  R = RIGHT MOVE, RI=RIT., RS=RESTART, READ=READ
48600	660	IF(I2.GE.IBLA)GO TO 680
48700		IF(I2.EQ.LEE)GO TO 200
48800	C ABOVE FOR 'READ'(SAME AS 'FILE')  
48900		IF(X22.NE.0)GO TO 260
49000	C GO BACK IF STILL IN EDIT MODE.
49100		IF(I2.EQ.LSS)GO TO 10
49200	C  TYPE 'RS' TO RESTART.
49300	CCCC	IF(I2.EQ.LEE)GO TO 200
49400	C ABOVE FOR 'READ'(SAME AS 'FILE')   NEXT FOR RIT.=37
49500		RD=37
49600		GO TO 880
49700	
49800	670	IF(I1.EQ.LCC)GO TO 1650
49900	680	IF(I1.EQ.LEE)GO TO 690
50000	C ABOVE FOR 'ED' (WITH LIGHT PEN)
50100		IF(X22.EQ.0)GO TO 130
50200	C  CAN'T MOVE ITEMS UNLESS REALLY IN EDIT MODE!
50300		IF(QUICK.EQ.0.AND.I2.NE.LEE)QUICK=2
50400	C NOW PARAMS DON'T PRINT OUT WHEN USING L,R,U,D***(BUT DE=DELETE)
50500	690	CALL EDIT(JJA)
50600		IF(JA.NE.99)GO TO 1110
50700		CALL DELETE
50800	C  DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
50900		GO TO 1700
51000	700	FORMAT(72A1)
51100	C  TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
51200	
51300	710	IF(QUICK.NE.0)GO TO 720
51400	C ↑↑↑ SO 'N n' WILL WORK EVEN AFTER N HAS BEEN SET.
51500		QUICK=1
51600	C TYPE 'N'  =NO-TYPE PARAMS  TO SUPPRESS TYPE-OUT WHILE EDITING.
51700		IF(X22.NE.0)GO TO 730
51800	720	I1=LII
51900	C  'N n' WHEN NOT IN EDIT MODE = 'I n'<CR>,'N'<CR>
52000	730	IF(I1.NE.LII)GO TO 750
52100	740	IF(I2.EQ.LNN)GO TO 570
52200	C  'IN n,n,n,' MUST BE READ AGAIN AT 886 TO GET n'S CORRECTLY.
52300		JA=223
52400	C JA=223 FOR EDIT MODE
52500		IF(CHNG.NE.0)GO TO 130
52600	C AFTER A CHANGE OF AN ITEM, 'I', ETC. IS ILLEGAL.
52700		IF(R2.EQ.0)GO TO 1110
52800		IF(R2.LT.1.0)GO TO 130
52900	C CATCHES TYPOS.  (I.E. DECI. NUMBER AFTER I)
53000		GO TO 1110
53100	
53200	750	IF(K)JA=55
53300	C   ED 47 -1 = 55 47 -1, ETC.
53400		IF(JA.EQ.101)GO TO 590
53500		IF(I1.NE.LNN)GO TO 760
53600		IF(R2.NE.0)GO TO 720
53700	C IF NO NUM FOLLOWS 'N' GO PRINT OUT CURRENT PARAMS.
53800		GO TO 290
53900	
54000	C  'Z' = ZOOM  (OLD CODE# 24)
54100	760	IF(I2.NE.LPP)GO TO 770
54200	CRR***	RSET4=R3
54300		RSET4=R2
54400	C SPn SETS "SETUP" STAFF NUMBER
54500		GO TO 130
54600	C  'SP' IS SAME AS 444
54700	C  'P n' = PRINT CURRENT CONTENTS OF PARAM n. (ONLY WHILE IN EDIT MODE.)
54800	770	IF(X22.EQ.0.OR.I2.EQ.LEL)GO TO 910
54900	C JUMP OUT IF 'TL' (TYPLOC)
55000		QUICK=0
55100	C TYPE 'T' TO RESET PARAM TYPE-OUT
55200		IF(R2.EQ.0)GO TO 130
55300		GO TO 720
55400	
55500	780	RD=14
55600	C PLUS
55700	CRR***790	REREAD 560,JA,R2,RJQ
55800	CRR790	CONTINUE
55900	800	IF(X22.NE.0)GO TO 130
56000	C CAN'T ENTER NEW ITEM WHILE IN EDIT MODE.
56100	CRR***	J=9
56200		JA=9
56300		R5=RD
56400		IF(R4.EQ.0)R4=15
56500		GO TO 900
56600	810	RD=5
56700	C ACCENT
56800	CRR***820	REREAD 2430,J,J,J,R2,RJQ
56900	CRR820	GO TO 800
57000		GO TO 800
57100	830	RD=7
57200	C STACC.
57300	CRR***	GO TO 820
57400		GO TO 800
57500	840	IF(I3.EQ.LEL)GO TO 200
57600	C  JUMP FOR HELP
57700		IF(X22.NE.0)GO TO 260
57800	C CAN'T DO NEXT IF STILL IN EDIT MODE.
57900		RD=13
58000	C HARMONIC
58100		IF(I2.EQ.LWW)RD=21
58200	C HEAVY WEDGE
58300	CRR***	GO TO 790
58400		GO TO 800
58500	850	RD=4
58600	C WEDGE
58700	CRR***	GO TO 790
58800		GO TO 800
58900	
59000	CRR***860	REREAD 560,JA,R2,RJQ
59100	860	R5=26
59200	CRR***	J=9
59300		JA=9
59400		IF(R4.EQ.0)R4=12
59500	C FERMATA
59600		GO TO 900
59700	
59800	870	IF(I2.EQ.LII)GO TO 200
59900		IF(X22.NE.0)GO TO 260
60000		R5=51
60100	C F=51 FF=52 FFF=53, FE=FERMATA, FILE
60200		IF(I2.EQ.IBLA)GO TO 890
60300		IF(I2.EQ.LEE)GO TO 860
60400		RD=53
60500		IF(I3.NE.IBLA)GO TO 500
60600		RD=52
60700	CRR***880	REREAD 560,JA,R2,RJQ
60800	880	R5=RD
60900	CRR***890	J=3
61000	890	JA=3
61100		IF(R4.EQ.0)R4=-5
61200	C ABOVE IS FOR DIRECT TYPING OF P,PP,PPP,MP,RIT., ETC.
61300	C IF PARAM 4 IS 0, PUTS IT -5 BELOW.
61400	CRR***900	JA=J
61500	900	IF(JA.GT.0)SAVER=SAVER-1
61600		IF(SAVER.LT.0.AND.CHNG.LT.0)CALL SAVIT
61700	C  SAVES EVERY 5TH TIME AROUND  (IF NO HANGING CHANGES IN DATA)
61800		IF(QUICK.EQ.2)QUICK=0
61900	C RESET QUICK(SUPRESSES PARAM PRINTOUT) IF CRLF AFTER L,R,U,D
62000		IF(X22.NE.0)GO TO 1110
62100		IOLD=0
62200	C RESET FLAG FOR "I" COMMAND
62300		IF(JA.EQ.0)GO TO 130
62400	C  CATCHES ZEROS
62500		GO TO 1110
62600	C NEXT FOR ALPHA TEXT ITEMS.  'T'=TYPE
62700	910	IF(I2.NE.LEE)GO TO 920
62800		RD=9
62900	C TENUTO
63000	CRR***	GO TO 790
63100		GO TO 800
63200	920	IF(I2.NE.LEL)GO TO 940
63300	CRR***	J3=R3
63400	CRR***	J4=R4
63500		J3=R2
63600		J4=R3
63700	C 'TL' SET LOCATION OF TYPE OUT ON SCREEN
63800		IF(J4.EQ.0)J4=J3-200
63900	C OMIT 2ND NUM. AND GET N AND N-200.
64000	CRR***	IF(R3.NE.0)GO TO 930
64100	CRR***	IF(R4.NE.0)GO TO 930
64200		IF(R2.NE.0)GO TO 930
64300		IF(R3.NE.0)GO TO 930
64400		J4=0
64500		J3=450
64600	C 'TL' 0 0 PUTS IT BACK TO ORIG. LOC.
64700	930	CALL TYPLOC(J3,J4)
64800		GO TO 130
64900	940	JA=16
65000	C ????'T' = TEST INPUT
65100		J2=R2
65200		M=I
65300		CALL WORDS
65400		SAVER=SAVER-1
65500		IOLD=0
65600		GO TO 1340
65700	
65800	950	IF(X22.NE.0)GO TO 130
65900		JA=140
66000		RMODE2=R3
66100	C  ?????  CHECK THIS  TYPE 'IN STF# MODE' ETC.  -- SAME AS 140 STF#.
66200	960	SCORE=0
66300		IF(JA.NE.140)GO TO 990
66400	C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
66500		SAVER=-1
66600		RSTF=R2
66700	C DO I NEED THE NEXT???
66800		IF(R3.LT.0)R3=0
66900		DO 970 K=1,ITEM
67000		J=PWDS(K)
67100		IF(RN(J+1).NE.8)GO TO 970
67200		IF(RN(J+2).EQ.R2)GO TO 980
67300	970	CONTINUE
67400	C DIDN'T FIND THIS STAFF
67500		M=LIMIT
67600	C ↑↑ WAS =2000 6/78
67700		IGO=0
67800		JA=8
67900		R3=0
68000		GO TO 1110
68100	980	JA=140
68200		ITCHK=ITEM
68300		ICHK=I
68400		IDPY=ST2
68500	C ALL THIS FOR BACKUPS
68600	990	SPD=ST2
68700		JIT=ITEM
68800		ISC=I
68900		REND=0
69000	C   RETAINS ORIGINS OF SCORE SQUENCE
69100	1000	IF(REND.EQ.2)GO TO 990
69200	C  FOR READIN CONTINUATION.
69300		M=ISC
69400	1010	IF(JA.EQ.8)GO TO 980
69500		IF(REND)GO TO 1050
69600	C REND=0 GO,  -1=NORMAL END,  1=ABORTED.
69700		CALL SCMSS
69800		IOLD=0
69900		IF(REND.EQ.1)GO TO 1050
70000		IF(REND.NE.99)GO TO 1020
70100		I=ICHK
70200		ITEM=ITCHK
70300		ST2=IDPY
70400		CALL ACCPOG(1)
70500	CC	CALL DPYOUT(1)
70600	        CALL DPYDO(1)
70700		GO TO 1050
70800	1020	ITEM=JIT
70900		J=M
71000	1030	ITEM=ITEM+1
71100		PWDS(ITEM)=J
71200		J=J+RN(J)+3
71300		IF(J.LT.I)GO TO 1030
71400		IF(IBEAM)GO TO 1040
71500		R13=0
71600		R2=RSTF
71700		JA=190
71800		J3=0
71900		CALL HOMER
72000	1040	ITEM=JIT
72100		ST2=SPD
72200		GO TO 1340
72300	1050	SCORE=-1
72400		CALL SHRINK(JIT)
72500	C  GETS RID OF ZEROS AT END OF NOTE PARAM LIST.
72600		IGO=-1
72700		JA=16
72800	C  FOR TRAP AT 'EDIT'
72900		GO TO 130
73000	
73100	1060	IGO=1
73200		CALL GRED
73300		JFONT=0
73400		IF(JA.EQ.98)GO TO 1080
73500		KNT=0
73600		SCORE=0
73700	
73800	1070	KNT=KNT+1
73900	C   NUM OF ITEMS IN LIST
74000		R11=0
74100		R10=0
74200		R9=0
74300		JA=R(1,KNT)
74400		R2=R(2,KNT)
74500		IF(JA.NE.0)GO TO 1090
74600	C  =0 MEANS NO MORE ITEMS.
74700	CC	CALL DPYOUT(1)
74800	        CALL DPYDO(1)
74900		GO TO 40
75000	
75100	1080	X22=0
75200		IGO=-1
75300		CALL DPYNEW
75400		GO TO 120
75500	
75600	1090	DO 1100 K=1,6
75700	1100	RJQ(K)=R(K+2,KNT)
75800	1110	M=1
75900		EDQ=-1
76000		IF(JA.EQ.222)GO TO 1650
76100		IF(JA.EQ.2222)GO TO 1670
76200		DO 1120 K=1,20
76300	1120	JQ(K)=RJQ(K)
76400	C  X22= ITEM# WHEN EDITING OR DELETING.
76500		IF(X22.NE.0)GO TO 1610
76600		IF(JA.GT.0)GO TO 1130
76700		IF(R2.EQ.0)GO TO 130
76800	C  FOR UP, DOWN, LEFT, RIGHT
76900		RJJ2=J2
77000		GO TO 1850
77100	C  GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
77200	1130	IF(JA.EQ.223)GO TO 1500
77300		IF(JA.EQ.44)GO TO 1510
77400	C  THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
77500		IF(JA.EQ.55)GO TO 1480
77600		IF(JA.NE.190)GO TO 1860
77700	1140	CALL HOMER
77800		GO TO 1790
77900	
78000	
78100	
78200	
78300	
78400	
     

00100	
00200	1150	IF(X22.EQ.0)GO TO 1350
00300	C  WHEN NOT IN EDIT MODE(X22=0) "P n n2" LISTS ALL PARAMS FOR ITEMS n→n2
00400		J2=R2
00500		TYPE 1160,J2,RJJ(J2-2)
00600	C  TYPE P n TO SEE FULL CONTENTS OF PARAM. n.
00700		GO TO 130
00800	1160	FORMAT(I,F15.5)
00900	
01000	1170	IF(X22.NE.0)GO TO 260
01100	C 'Z' = ZOOM   CAN'T DO ZOOM WHILE IN EDIT MODE
01200		IF(I2.NE.LDD.AND.I2.NE.LUU)CALL HYDPOG(2)
01300	C CLEAR SPACING SCALE IF NOT MOVING UP OR DOWN.
01400		JA=24
01500		IGO=0
01600	1180	IF(R2.LT.200)GO TO 1190
01700		R3=AMOD(R2,100.)
01800		R2=(R2-R3)/100.
01900		R4=5*IFIX(9.0/R2)
02000	C Z240 GIVES 2 40 20. Z366 GIVES 3 66 15.  Z490 GIVES 4 90 10.
02100	1190	IF(R2.GT.1.OR.R3+R4.NE.0)GO TO 1195
02200		R3=50.0
02300		R4=50.0
02400	C  Z1 ONLY ADDS IN 50,50   SO WE CAN ZOOM UP AND DOWN AT ANY SIZE.
02500	1195	IF(I2.GT.0)GO TO 1250
02600	C NEXT SECTION FOR ZLn, ZRn, ZUn, ZDn. n=% OF SCREEN CHANGE OF CENTER PO
02700	CRR***	REREAD 560,R3,R3
02800	C FOR SOME REASON ONLY 'ZD' NEEDS THIS REREAD?!?!?!?  FORMAT(A2,21F)
02900		R3=R2
03000	CRR*** ABOVE REPLACES REREAD
03100		IF(R3.EQ.0)R3=RZZZ
03200		RZZZ=R3
03300	C SAVE R3 FOR REPEAT OF COMMAND WITHOUT n.
03400		R3=R3/RZMSZ
03500	C 'ZR10' MEANS MOVE CENTER OF IMAGE 10% OF SCREEN SIZE TO RIGHT.
03600		IF(I2.NE.LRR)GO TO 1220
03700		R3=-R3
03800	1200	R3=RZMX+R3
03900		R4=RZMY
04000	1210	R2=RZMSZ
04100		GO TO 1290
04200		DATA RZMSZ/1.0/,RZMX/50.0/,RZMY/50.0/
04300	C DATA STATEMENT NEEDED TO GET CORRECT NUMS. FOR ZU,ZD, ETC. BEFORE Z1, ETC.
04400	1220	IF(I2.EQ.LEL)GO TO 1200
04500		IF(I2.NE.LUU)GO TO 1240
04600		R3=-R3
04700	1230	R4=RZMY+R3
04800		R3=RZMX
04900		GO TO 1210
05000	1240	IF(I2.EQ.LDD)GO TO 1230
05100	
05200	1250	JCLIP=525
05300	C SETS CLIP LIMITS IN CLIP SUBR.
05400		IF(R2.NE.0)GO TO 1270
05500		IF(I2.EQ.LZZ)GO TO 1280
05600		IGO=-1
05700	1260	R2=1.
05800	C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
05900	1270	IF(R2.LE.1)GO TO 1290
06000		JCLIP=511
06100		IF(R3.NE.0)GO TO 1290
06200	1280	CALL ZCRSOR
06300	C 'Zn' (AND NO OTHER NUM) WHERE n >1 ALLOWS YOU SET CENTER WITH LIGHTPEN
06400	1290	RSZ=.845*R2
06500		RZMSZ=R2
06600		RZMX=R3
06700		RZMY=R4
06800	C REMEMBER FACTORS
06900		JCEN=0
07000		KCEN=0
07100	CZOO	IF(R2.EQ.1)GO TO 1310
07200	CZOO	IF(R2.LT.1)GO TO 1300
07300		JCEN=(R3*10-500)*RSZ
07400		KCEN=(R4*10-480)*RSZ
07500	C  NEXT TO RECONSTITUTE SPACING SCALE.
07600	1300	R2=(R4-100.)/100.
07700	C%%%%%%%%%%%%%
07800		IF(R2.LT.0)R2=0
07900	C  WE DON'T WORRY IF IT'S TOO HIGH (YET).
08000	1310	R4=0
08100		R2=0
08200	    	IF(RZMSZ.LT.2)R2=1.
08300	C SETS HEIGHT OF SPACE NUMS. DEPENDING ON ZOOM FACTOR
08400	Cxxxxxxx 12/79	CALL SCL
08500		R2=0
08600		R3=0
08700		R4=0
08800		LCEN=0
08900		MCEN=0
09000	C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
09100		JFONT=0
09200	1320	M=1
09300		I=PWDS(ITEM+1)
09400		ITEMX=ITEM
09500	C FOR USE IN CENTERING WHOLE RESTS (IN NOTWRT [NTSM.FAI])
09600		ITEM=0
09700	1330	ST2=3
09800	1340	PLT=1
09900		EDQ=0
10000		CALL ACCPOG(1)
10100		IF(JA.EQ.0)GO TO 2370
10200		IF(JA.NE.24)IGO=0
10300		GO TO 2370
10400	
10500	1350	IF(I2.EQ.LRR)GO TO 1360
10600	C NOW TYPE 'PR' TO PRINT PARAMETER LIST
10700		R5=42
10800		IF(I2.EQ.IBLA)GO TO 890
10900		IF(I2.EQ.LPP)RD=41
11000	C PPP=40 PP=41 P=42 POCO=72 PIU=91
11100		IF(I2.EQ.LII)RD=91
11200		IF(I2.EQ.LOH)RD=72
11300		IF(I2.EQ.LEL)GO TO 780
11400	C PLUS
11500		IF(I2.EQ.LZZ)GO TO 1370
11600	C PIZZ
11700		IF(I3.EQ.IBLA)GO TO 880
11800		RD=40
11900		GO TO 500
12000	1360	CALL LISTP(LST)
12100		GO TO 130
12200	
12300	1370	RA=51857895.
12400		RB=95389999.
12500	C PIZZ.
12600	1380	RD=0
12700	1390	RE=1
12800	CRR***1400	J=16
12900	1400	JA=16
13000	CRR***	REREAD 560,JA,R2,RJQ
13100		R6=RA
13200		R7=RB
13300		R8=RD
13400		IF(R5.EQ.0)R5= RE
13500		IF(R4.EQ.0)R4=14
13600	C 0=PUT IT ABOVE STAFF
13700		GO TO 900
13800	1410	RA=51704789.
13900		RB=74828584.
14000		RD=99999999.
14100	C A TEMPO
14200		GO TO 1390
14300	1420	RA=51708772.
14400		RB=84999999.
14500	C ARCO
14600		GO TO 1380
14700	1430	RA=40999999.
14800	1440	RB=0
14900		GO TO 1380
15000	C LEFT AND RIGHT PARENTHESES AND COMMA
15100	1450	RA=41999999.
15200		GO TO 1440
15300	1460	RA=36999999.
15400		RB=0
15500		RD=0
15600		RE=1.5
15700	C COMMA IS DEFAULT SIZE 1.5
15800		GO TO 1400
15900	
16000	1470	CALL JUGGLE
16100		CALL CLRCUR
16200		CALL DPYNEW
16300		CHNG=0
16400	C RESET CHANGE FLAG - CLEAR EDIT MODE ERROR TRAP
16500		IF(JA.EQ.223)GO TO 1690
16600	C  FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
16700		IF(ZERO)GO TO 120
16800		X22=ZERO
16900		ZERO=-1
17000		IF(JA.EQ.55)GO TO 1480
17100		IF(JA.EQ.44)GO TO 1510
17200		IF(KED.NE.0)GO TO 1530
17300		GO TO 1700
17400	
17500	C  55,POS  -- SETS UP ALIGNMENT
17600	1480	IF(I2.NE.LSS)GO TO 1490
17700		CALL EXCH(R2,R3)
17800		J3=R3
17900	C 'ES' IS "EDIT, STAFF, POS., CODE"
18000	C 'ED' IS "EDIT, POS., STAFF, CODE"
18100	1490	CALL BOX(-1,R2)
18200		IF(J4.EQ.0)KED=-1
18300		RITEM=R4
18400	C  FOR 'ED POS., STF., CODE#'   (STF > 7 = ALL STAVES)
18500		IF(J3.GT.7)KED=-2
18600		RLINE=R2
18700		R2=R3
18800		GO TO 1520
18900	
19000	C  '223,0' EDITS LAST ITEM ENTERED
19100	1500	REDIT=999.0
19200		IF(R2.NE.0)GO TO 1550
19300		X22=ITEM
19400		IF(IOLD.EQ.0)GO TO 1710
19500		IF(IOLD.LE.ITEM)X22=IOLD
19600		GO TO 1710
19700	1510	KED=1
19800		RITEM=R3
19900	C  'ST*, STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>7 = ALL STAVES.
20000		IF(R2.GT.7)KED=2
20100	1520	REDIT=R2
20200	C  THE STAFF #
20300		JED=1
20400	
20500	
20600	1530	IF(EDX(RLINE).GE.0)GO TO 1670
20700	CC244   X=ITEM
20800	CC      IF(JED.GT.X)GO TO 444
20900	CC      DO 144 K=JED,X
21000	CC      L=PWDS(K)
21100	CC      IF(KED.EQ.-2)GO TO 654
21200	C  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
21300	CC      IF(KED.EQ.2)GO TO 656
21400	CC      IF(RN(L+2).NE.REDIT)GO TO 144
21500	CC      IF(KED)GO TO 654
21600	CC      IF(RITEM.EQ.0)GO TO 655
21700	CC656   IF(RITEM.NE.RN(L+1))GO TO 144
21800	CC655   IF(JA.NE.55)GO TO 344
21900	CC654   IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
22000	CC144   CONTINUE
22100	CC444   REDIT=999.
22200	C  NO MORE ON LINE
22300	CC      R2=0
22400	C   SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
22500	CC      GO TO 73
22600	CC344   JED=K+1
22700	C  FOR NEXT TIME AROUND
22800	CC      X22=K
22900		GO TO 1710
23000	C  CR MOVES ALONG GIVEN LINE,  222 LEAVES THIS MODE
23100	
23200	1540	CALL ACCPOG(1)
23300		IF(I.EQ.IX)ITEM=ITEM-1
23400		GO TO 1560
23500	1550	IF(X22.GT.0)GO TO 1610
23600	1560	IF(R2.NE.0)GO TO 1690
23700		IF(JA.NE.0)MINUZ=0
23800		IF(REDIT.EQ.999)GO TO 1570
23900		IF(JA.GT.0)GO TO 1530
24000	
24100	1570	IF(JA.GE.0)GO TO 1580
24200		X22=X22+JA
24300	C FOR TYPING '-n'
24400		GO TO 1600
24500	1580	IF(I1.EQ.PLUS)MINUZ=0
24600		IF(I1.EQ.MINUS)MINUZ=-1
24700	C TYPE '-' WITH NO NUM. TO BACKUP WITH CRLF ONLY
24800	C TYPE '+' TO GO FORWARD
24900		IF(MINUZ.LT.0)GO TO 1590
25000		IF(REDIT.NE.999.)GO TO 1530
25100	C JUMP IF IN 'ED' OR 'ST' MODES
25200		X22=X22+1
25300		GO TO 1700
25400	1590	X22=X22-1
25500	1600	IF(X22.LT.1)GO TO 1670
25600	C EXIT FROM EDIT MODE IF GONE OFF BOTTOM
25700	CC4554  IF(X22.LT.1)X22=1
25800		GO TO 1700
25900	
26000	*******
26100	CC1554  X22=X22+1
26200	CC      IF(JA.EQ.0)GO TO 4554
26300	CC      X22=X22-1+JA
26400	CC      GO TO 5554
26500	CC4554  IF(I1.NE.MINUS)GO TO 3554
26600	CC      MINUZ=-1
26700	C TYPE '-' WITH NO NUM. TO BACKUP WITH CRLF ONLY
26800	CC3554  IF(MINUZ.LT.0)X22=X22-2
26900	CC      IF(X22.LT.1)X22=1
27000	CC      GO TO 425
27100	
27200	C  FOR EDITING
27300	1610	IF(JA.EQ.55)GO TO 1800
27400	1620	IF(JA.NE.223)GO TO 1630
27500	C  'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
27600		KED=0
27700		JED=0
27800		GO TO 1650
27900	1630	IF(JA.EQ.44)GO TO 1800
28000	C  FOR '24' WHILE IN EDIT MODE.  MAGS WITH CURSOR AS CENTER.
28100		IF(JA.GT.100)GO TO 1640
28200		IF(JA.GT.13)GO TO 130
28300	C  PARAM NUM TOO HIGH?  LOOKS FOR NEXT ITEM TO EDIT IF <CR>
28400	1640	IF(X22.EQ.0)GO TO 1720
28500		IF(R2.NE.0)GO TO 1720
28600	C  BACKS UP WHEN IN EDIT MODE.
28700	
28800		IF(JA.GT.0)GO TO 1730
28900		IF(I.EQ.IX)GO TO 1540
29000		IF(CHNG.NE.0.AND.JA.LT.0)GO TO 130
29100	C CAN'T DO '-N' AND OTHER THINGS AFTER CHANGES IN EDIT MODE.
29200		ZERO=X22+1
29300	C  '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
29400	1650	IF(X22.EQ.0)GO TO 120
29500		IF(KED.EQ.0)REDIT=999.
29600	1660	IF(I.NE.IX)GO TO 1470
29700		ITEM=ITEM-1
29800	C  TO DELETE AN ITEM
29900	1670	X22=0
30000		MINUZ=0
30100	C MINUS SIGN FLAG (WHEN -1, CRLF=BACKUP)
30200		CHNG=0
30300	C RESET CHANGE FLAG
30400		CALL CLRCUR
30500		CALL DPYNEW
30600		IF(REDIT.EQ.999.)GO TO 1680
30700		IF(JA.EQ.55)GO TO 1480
30800		IF(JA.EQ.44)GO TO 1510
30900	1680	IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 120
31000	C  DELETION IN EDIT MODE DOES NOT LEAVE MODE.
31100	1690	X22=R2
31200	1700	IF(X22.GT.ITEM)GO TO 1670
31300	C  LEAVES EDIT MODE.
31400	1710	CALL BOXX
31500	CC429   IX=I
31600	CC      MEDIT=PWDS(X22)
31700	CC      J=2
31800	CC426   Y=RN(MEDIT)+J
31900	CC      CALL LOOP(0,Y,1,I,MEDIT,RN)
32000	CC      JJA=RN(I+1)
32100	CC      YED=Y-2
32200	CC      L=I+2
32300	CC      DO 422 K=1,11
32400	CC      IF(K.GT.YED)GO TO 423
32500	CC      RJJ(K)=RN(L+K)
32600	CC      GO TO 422
32700	CC423   RJJ(K)=0
32800	CC422   CONTINUE
32900	CC      RJJ2=RN(L)
33000	CC      IF(IGO.GT.0)GO TO 4231
33100	C  NO BOX WHEN IN GROUP EDIT ROUTINE
33200	CC      IBOX=I
33300	CC      RBOX=RJJ2
33400	CC      CALL BOX(IBOX,RBOX)
33500	CC4231  ITEM=ITEM+1
33600	CC      ST2=WDS(ITEM)
33700		GO TO 120
33800	
33900	1720	IF(JA.EQ.0)GO TO 1850
34000	1730	X=100-JA
34100		IF(X)JA=JA/100
34200		IF(JA.LE.2)GO TO 1820
34300		CALL EQUAL(X)
34400	CC      IF(JA.LE.13)GO TO 324
34500	CC      JA=JA/10
34600	C ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
34700	CC      X=R2-2.
34800	CC      RJJ(JA-2)=RJJ(X)
34900	CC      GO TO 6222
35000	CC324   I1=JA-2
35100	CC      IF(X)GO TO 224
35200	CC      RJJ(I1)=R2
35300	CC      GO TO 6222
35400	CC224   RJJ(I1)=RJJ(I1)+R2
35500		GO TO 1840
35600	
35700	1740	IF(X22.EQ.0)GO TO 1770
35800	C 'C' = COPY (IN OR OUT OF EDIT MODE) CR=CRESC.
35900	CC      IF(I2.EQ.IBLA)GO TO 883
36000		IF(I2.NE.IBLA)GO TO 1760
36100	1750	IF(CHNG.EQ.0)GO TO 130
36200	C CAN'T 'COPY' UNLESS CHANGES WERE MADE.
36300		IOLD=0
36400		GO TO 650
36500	1760	IF(I2.EQ.LPP)GO TO 1761
36525	C CP n =CENTER BY NOTE POSITION
36550		IF(R2.NE.0)GO TO 1750
36600	C IS THERE A NUMBER AFTER C
36700		R2=1
36800	C CN=CENTER, CH=AT HEAD, CT=AT TAIL, CX=EXIT FROM CENTERING MODE.
36900		JA=13
37000		IF(I2.EQ.IXX)R2=0
37100		IF(I2.EQ.LHH)R2=-R2
37200		IF(I2.EQ.LTT)R2=-2
37300		IF(I2.EQ.LBB)CB=6
37400		IF(I2.EQ.LVV.OR.I2.EQ.LDD)CB=-1
37500		IF(I3.EQ.LVV)CB=CB-10
37600	C TYPE 'CB' FOR CENTER-BIG  (BIG RANGE =6) ***** 'CV'=SET CURVE OF SLUR
37700	C CBV, CHV, CTV WILL SET CURVE AND DO CENTERING.  CD CENTERS DASH BETWEEN WDS.
37800		GO TO 1110
37820	1761	CALL SETLET
37860		GO TO 1110
38000	1770	IF(I2.EQ.IBLA)GO TO 1780
38100	C NEXT FOR ME=MENO=81 MOLTO=90 CRESC.=70 MP=43 MF=50, ALSO 'MACRO'
38200		RD=43
38300		IF(I2.EQ.LAA)GO TO 2400
38400		IF(I2.EQ.LFF)RD=50
38500		IF(I2.EQ.LOH)RD=90
38600		IF(I2.EQ.LEE)RD=81
38700		IF(I2.EQ.LRR)RD=70
38800		IF(I2.NE.LTT)GO TO 880
38900	C JT=JUSTIFY TEXT (ONLY 1 STAFF AT A TIME)
39000	1780	CALL MOVER
39100		IF(R2.GE.99)GO TO 260
39200	C   99(+)=BACKUP OUT OF MOVER ETC.
39300		IGO=0
39400		JFONT=0
39500	C  SO IT WON'T DO ALL FONT LOOKUPS.
39600	1790	IF(JJ2)GO TO 130
39700		M=PWDS(JJ2)
39800		I=PWDS(ITEM+1)
39900		ITEM=JJ2-1
40000		ST2=WDS(JJ2)
40100	C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
40200		GO TO 1340
40300	
40400	1800	IF(REDIT.NE.55.)REDIT=0
40500	C NEEDED FOR 'S'ET, THEN 'A'LIGNE ROUTINE
40600		IF(I2.NE.IBLA)GO TO 1660
40700	C WE GET HERE WHEN TYPING 'ST' OR 'ED' WHEN ALREADY IN EDIT MODE.
40800		IF(R2.EQ.0)GO TO 1810
40900		IF(CHNG.NE.0)GO TO 130
41000	C CATCH 'S'ET AFTER A CHANGE WAS MADE.
41100		GO TO 1660
41200	C GO PAST HERE ONLY FOR 'A'LIGN
41300	1810	IF(KED.GE.0)RLINE=RJ3
41400		RJ3=RLINE
41500		GO TO 1840
41600	C  FOR '55' ALIGNING
41700	1820	IF(X)GO TO 1830
41800		CALL PARCH(JA,JJA,R2)
41900		GO TO 1840
42000	1830	RJJ2=R2+RJJ2
42100	C  ARRAYS NEED 2O LOCATIONS HERE.
42200	C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122  4,13  5,-2 ETC.)
42300	1840	CALL RJED
42400	1850	CALL RJED2
42500	C BELOW IS NOW IN 'LOOP.FAI'
42600	CC6222  DO 1222 K=1,20,2
42700	CC      L=JQ(K)
42800	CC      IF(L.EQ.0)GO TO 6221
42900	C  '600 2'  WILL ADD 2 TO PARAM 6.  '3000 6' SETS P3=P6.
43000	CC      RD=RJQ(K+1)
43100	CC      X=L
43200	CC      IF(L.LT.100)GO TO 223
43300	CC      IF(L.LT.2000)GO TO 5223
43400	CC      X=L/1000
43500	CC      L=JQ(K+1)-2
43600	CC      RD=RJJ(L)
43700	CC      GO TO 2223
43800	CC5223  X=L/100
43900	CC      IF(X.EQ.2)GO TO 1223
44000	CC      RD=RJJ(X-2)+RD
44100	CC      GO TO 2223
44200	CC1223  RD=RJJ2+RD
44300	CC223   IF(X.LE.2)GO TO 3223
44400	CC2223  RJJ(X-2)=RD
44500	CC      GO TO 1222
44600	CC3223  CALL PARCH(X,JJA,RD)
44700	C NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
44800	CC1222  CONTINUE
44900	C***  LOOP SET TO 11 (20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
45000	CC6221  DO 5514 K=1,11
45100	CC      R2=RJJ(K)
45200	CC      RJQ(K)=R2
45300	CC5514  JQ(K)=R2
45400	CC      R2=RJJ2
45500	CC      JA=JJA
45600	CC      ITEM=ITEM-1
45700	CC      IF(ITEM)ITEM=0
45800		ST2=WDS(ITEM+1)
45900		I=PWDS(ITEM+1)
46000		IF(X22.NE.0)CHNG=-1
46100	C SET CHANGE FLAG TO TRAP EDIT MODE ERRORS. (CLEARED AT 172)
46200		CALL DPYNEW
46300	
46400	
46500	
46600	
46700	
46800	
     

00100	1860	J2=R2
00200		IF(J2.LT.0)GO TO 130
00300		IF(J2.GT.7)GO TO 130
00400	C STOPS TYPO ERROR ON STAFF NUM. (<0, >7)
00500		RSTJ2=RSTFAC(J2)
00600	C*      IF(JA.NE.2)GO TO 163
00700	C*      IF(R8.EQ.0)GO TO 163
00800	C*      IF(R8.EQ.-1)GO TO 163
00900	C*      IF(R8.EQ.-4)GO TO 163
01000	C R8=0=AS IS; -1=WHOLE REST; >0=NUMBER OVER REST; -2=CENTERED
01100	C R8=-3 = CENTERED REST (BUT NOT CHANGED TO WHOLE)
01200	C R8=-4 = MEASURE REPEAT SIGN. =-5 = REPEAT SIGN CENTERED.
01300	C*      K=ITEM
01400	C  ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
01500	C*      IF(X22.NE.0)K=X22-1
01600	C*      RD=1.75*RSTJ2
01700	C*      L=PWDS(K+2)
01800	C*      IF(RN(L+1).NE.4)GO TO 164
01900	C  GO ON IF NEXT ISN'T BAR LINE (CODE 4. NEXT FINDS OTHER LINES!!)
02000	C*      IF(RN(L+2).NE.R2)GO TO 164
02100	C*      RB=RN(L+3)
02200	C*      L=PWDS(K)
02300	C  CHECK PREV. AND NEXT ITEM.  IF NOT BAR, DON'T TRY TO CENTER!
02400	C*      IF(RN(L+1).NE.4)GO TO 164
02500	C*      IF(RN(L+2).NE.R2)GO TO 164
02600	C  JUMP IF NOT ON SAME STAFF
02700	C*      RA=RN(L+3)
02800	C*      R3=RA+(RB-RA)/2-1.75*RSTJ2
02900	C*164   IF(PLT.EQ.0)GO TO 160
03000	C*      RN(PWDS(K+1)+3)=R3
03100	C  ******* A DANGEROUS PLACE.  KEEP TRACK OF THIS
03200	C*      GO TO 5541
03300	
03400	1870	IF(JA.EQ.16)GO TO 1910
03500		IF(PLT.NE.0)GO TO 2080
03600		IF(JA.NE.2)GO TO 1880
03700		IF(R8.NE.0)GO TO 2010
03800		IF(R9.NE.0)R9=0
03900		GO TO 2010
04000	1880	IF(JA.NE.8)GO TO 1900
04100		IF(R9.NE.1)GO TO 2010
04200		L=7
04300		K='INST.'
04400	C  RJQ(7) IS R9
04500	1890	RA=RN(MEDIT+L+2)
04600		CALL TYPCHR(RA,5)
04700		CALL TYPCRL
04800		CALL TYPSTR('TYPE ')
04900		CALL TYPCHR(K,5)
05000		CALL TYPSTR(' NAME   ')
05100		READ(IDEV,FA5)RD
05200		CALL LO2UP(RD)
05300		RJQ(L)=RD
05400		IF(RD.NE.' ')GO TO 2010
05500		IF(RN(MEDIT).LT.L)RA=0
05600	C  RESTORES NAME IF THERE WAS ONE ALREADY. ELSE=0
05700		RJQ(L)=RA
05800	C  WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
05900		GO TO 2010
06000	CF371   FORMAT(A5,A1,A3)
06100	1900	IF(JA.NE.11)GO TO 2010
06200	C  ↑↑↑↑ WAS - TO 63
06300		IF(J10.NE.1)GO TO 2010
06400		K='FILE'
06500		L=8
06600	C   P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
06700		GO TO 1890
06800	C  IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
06900	1910	RD=R5
07000		IF(RD.GE.100)RD=RD-100
07100	C ADD 100 TO SZ TO MAKE TEXT APPEAR IN ALL SEPARATE PARTS OF ORCH. SCORE
07200		IF(J10.EQ.0)GO TO 2000
07300		L=ITEM
07400		IF(X22.NE.0)L=X22-1
07500		IF(J10.EQ.1)GO TO 1980
07600	C  TEMP. FIX TO CNVT TEXT FORMAT TO NEW STYLE.  "10 99"
07700	C*	IF(J10.NE.99)GO TO 1950
07800	C*	X=PWDS(X22)+6
07900	C*	DO 1920 L=X,X+2
08000	C*	RB=RN(L)
08100	C*	K=RB
08200	C  CHECKS TO SEE WHICH FORMAT
08300	C*1920	IF(K.NE.RB)GO TO 1930
08400	C*	GO TO 70
08500	C*1930	DO 1940 L=X,X+2
08600	C*1940	RN(L)=RN(L)*100.
08700	C*	GO TO 70
08800	
08900	C  NEXT FOR CENTERING TEXT.  P10>1
09000	1950	RB=0
09100		X=PWDS(L+1)
09200	1960	L=L+1
09300		K=PWDS(L)
09400		RB=RB+RN(K+9)
09500	C  ADD SPACE NEEDED
09600		K=PWDS(L+1)
09700		IF(RN(K+1).NE.16)GO TO 1970
09800		IF(RN(K).EQ.8)GO TO 1960
09900	C GO BACK IF MORE LETTERS TO COME
10000	1970	R3=R10-(RB-3.4)*RD*RSTJ2/2.
10100	C  +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
10200		R10=0
10300		IF(RN(X).EQ.8)RN(X+10)=0
10400		RN(X+3)=R3
10500	C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
10600		GO TO 2000
10700	1980	K=PWDS(L)
10800		R3=AMOD(RN(K+5),100.)*RSTJ2*RN(K+9)+RN(K+3)
10900	C  AMOD BECAUSE P5+100 IS USED FOR PARTS PROGRAM.
11000		R4=RN(K+4)
11100		R5=RN(K+5)
11200		R2=RN(K+2)
11300		J2=R2
11400		L=PWDS(L+1)
11500		DO 1990 JJA=3,5
11600	1990	RN(L+JJA)=RJQ(JJA-2)
11700		RN(L+2)=R2
11800	2000	IF(PLT.NE.0)GO TO 2080
11900	2010	RJ3=R3
12000		JJA=JA
12100		IF(R8.NE.0)GO TO 2020
12200		IF(JA.EQ.1)R8=999.
12300	C  999=0 FOR STEM EXTENSIONS.
12400	C  USES ONLY 10 PARAMETERS BEYOND JA, J2
12500	2020	CALL MSSLUP
12600		IF(JA.NE.6)GO TO 2040
12700	CX I DON'T THINK THIS NEXT IS NEEDED NOW. 9/78  IF(J13.EQ.0)GO TO 171
12800	CX      R2=X22
12900	CX      X22=0
13000	CX      R3=R13
13100	CX      J3=J13
13200	CX      R4=R11
13300	C  RESET HOMING RANGE (DEFAULT=3) WITH P11.
13400	CX      CALL CLRCUR
13500	CX      R13=0
13600	C  TYPE 13, n WITH BEAMS TO ADJUST IN RE. TO OTHER STAFF(LIKE OLD 'AD')
13700	CX      JA=190
13800	CX      GO TO 271
13900	2030	CALL HOMER
14000	
14100	2040	IF(R13.EQ.0)GO TO 2070
14200		RD=R11
14300		IF(CB.EQ.0)GO TO 2050
14400	C *** CB = CENTER-BIG  I.E. BIG RANGE FOR CENTERING -- 6 UNITS. (CAN VAR
14500		X=CB+10
14600		IF(CB.LT.-1)CB=X
14700	C CBV  NOW=-4, CHV AND CTV =-10
14800		IF(RD.EQ.0)R11=CB
14900		IF(JA.NE.4)GO TO 2045
15000		IF(CB.GE.0)GO TO 2050
15100		CALL DASHES(ITEM,R2,RJQ)
15200	C SUBR. DASHES WILL CENTER DASH BETWEEN TO WORDS OR SYLLABLES. (TYPE 'CD')
15300		GO TO 2060
15400	2045	IF(JA.NE.5.OR.CB.GT.0)GO TO 2050
15500	C *** CV = SET CURVE OF SLUR. (FOR USE AFTER SPACE CHANGES, ETC.)
15600		R7=RCURVE(R3)
15700	CC      R7=0.9+(R6-R3)/25.+ABS(R4-R5)/10.
15800	C SAME FORMULA AS FOUND IN SLURZ ROUTINE.  FUNCTION CURVE IS IN LOOP
15900	CC      IF(R7)RB=-RB
16000	CC DONE IN 'RCURVE'***  R7=RB
16100		RJ7=R7
16200		IF(X.GT.0)GO TO 2060
16300		GO TO 2060
16400	2050	CALL HOMER
16500	2060	CB=0
16600		R11=RD
16700	C  R11 GETS CHANGED IN 'HOMER'
16800	CC      IF(JA.EQ.2.AND.R9.NE.0)CALL RSTCEN
16900	C RSTCEN IS FOR CENTERING WHOLE RESTS.
17000		IF(JA.EQ.10)R3=R3+RSTJ2
17100		IF(JA.NE.9)GO TO 2070
17200		IF(J5.GT.3)GO TO 2070
17300		CALL NOZERO(R6)
17400		R3=R3+RSTJ2+2.*RSTJ2*R6
17500	C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
17600	C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
17700	C  P13=-1 POSITIONS ITEM ABOVE OR BELOW NOTE, =-2 JUST BEYOND STEM.
17800	C CODE 10 (NUMBERS) SPACED TO LEFT AS WELL AS CODE 9, P5=1,2,3 (FLAT,SHR
17900	C **** FOR '0' EDITS ******
18000	2070	CALL LUP2
18100	2080	IF(DP(J2).GE.0)GO TO 2090
18200		IF(JA.NE.8)GO TO 70
18300	C NOW GET SIZE FACTOR, IF IT'S THERE. (NEEDED IN 'SCORE' SECTION.)
18400		IF(R5.NE.0)RSTFAC(J2)=R5
18500		GO TO 70
18600	C*** 3/74  NEW DP SYSTEM
18700	C  WHAT ABOUT EDITS?*******
18800	2090	POS=STFF(J2)
18900		RX3=R3
19000	C  SAVES IT IN RJQ(20) FOR OTHER ROUTINES.
19100		J3=ROFF(RHORZ(R3))
19200	C  LINE IS DIVIDED INTO 200 POINTS.
19300		CALL CENTX
19400	C  SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
19500		R3=J3
19600		IF(JA.LE.2)GO TO 60
19700	2100	GO TO(2430,2430,2130,2210,2140, 2190,2150,2180,60,2120, 2130,2200)
19800		1,JA
19900		GO TO (2150,2160,2170),JA-15
20000	C  FOR 16,17,18 (WORDS, KSIG, METER)
20100		IF(JA.EQ.99)GO TO 70
20200	C    FOR PART EXTRACTOR TRANSPOSER - KEY SIG=0
20300		IF(JA.NE.33.AND.JA.NE.44)GO TO 2110
20400		JA=JA/11
20500	C  THIS IS TEMPORARY - TO READ PAGE TEMP. FILES.
20600		GO TO 2100
20700	
20800	2110	I=PWDS(ITEM+1)
20900		GO TO 130
21000	C  44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
21100	
21200	2120	CALL MAKNUM(R5)
21300		GO TO 70
21400	
21500	2130	CALL CLEFS
21600		GO TO 70
21700	
21800	2140	CALL SLUR
21900		GO TO 70
22000	
22100	2150	CALL ALPHA
22200		GO TO 70
22300	
22400	2160	CALL KSIG
22500		GO TO 70
22600	
22700	2170	CALL METER
22800		GO TO 70
22900	
23000	2180	IF(R2.EQ.0)RMOV=R8
23100		CALL STAFF
23200		GO TO 70
23300	CC625   IF(J10.LT.100)GO TO 1625
23400	CC      CALL BEAMX
23500	CC      GO TO 160
23600		
23700	2190	CALL BEAMX
23800	CC625   CALL BMSTF
23900		GO TO 70
24000	C   BEAMS, STAFF LINES ****
24100	2200	CALL CIRCLE
24200		GO TO 70
24300	
24400	2210	CALL ITMSUB
24500	C   BAR LINES, ETC.
24600		GO TO 70
24700	
24800	C  TO GET DISPLAY: 'G'; 'GM'  ADDS TO DPY;
24900	CC120   IF(X22.NE.0)GO TO 59
25000	C GO BACK IF STILL IN EDIT MODE
25100	2220	J2=0
25200		IF(I.EQ.1)GO TO 2230
25300		L=NAME
25400		X=EXT
25500		IF(I2.EQ.IBLA)GO TO 2110
25600		J2=-1
25700		I2=(I2-'0')/536870912
25800	C TURN ASCII INTO INTEGER.
25900		IF(I2.GT.9.OR.I2.LT.0)GO TO 2230
26000	C VERT. STEPS PER INCH = 23.9 (CONSIDER STAFF SIZE FACTOR TOO)
26100		R2=I2
26200		J2=1
26300	C  'GM'=GET MORE(BUT OLD OUTPUT NAME IS RESTORED AT 2207)
26400	C 'Gn'=GET MORE AND PUT IT ON STAFF n AT POS. OF STAFF 0'S P8.
26500	C ANYTHING AFTER 'G' BUT A NUMBER IS TAKEN AS 'GM'.
26600	2230	I1=-1
26700		CALL NAMEXT(INP,NAME,EXT)
26800	C  NOW TYPE 'G NAME' OR 'GM NAME'
26900		IF(NAME.NE.IBLA)GO TO 2250
27000	2240	CALL TYPSTR(' NAME.EXT?  ')
27100		READ(IDEV,700,END=240)INP
27200	C GO PUT A1'S INTO A5, ETC.
27300		CALL NAMEXT(INP,NAME,EXT)
27400		IF(NAME.EQ.IBLA)GO TO 2270
27500		IF(NAME.NE.'99')GO TO 2250
27600	C TYPE '99' TO BACK OUT OF 'SAVE'.
27700		NAME=L
27800		EXT=X
27900		GO TO 130
28000	2250	IF(I1.NE.LESS)GO TO 2260
28100		IDEV=5
28200		GO TO 2240
28300	2260	CALL LO2UP(NAME)
28400		CALL LO2UP(EXT)
28500		IF(LOOKX(NAME,EXT).EQ.0)GO TO 2240
28600	C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
28700	2270	JA=-1
28800	C  -1 IS FOR 8852+3
28900	2280	J=ITEM+1
29000		IF(NAME.NE.IBLA)GO TO 2290
29100	C***	CALL GETEXT('TMP','MS ')
29200	C****	CALL INMUS('TMP','MS',RN(I),PWDS(J),RSTFAC)
29300		K='TMP'
29400		JJ2='MS'
29500		GO TO 2300
29600	C***2290	CALL GETEXT(NAME,EXT)
29700	C**** 2290	CALL INMUS(NAME,EXT,RN(I),PWDS(J),RSTFAC)
29800	2290	K=NAME
29900		JJ2=EXT
30000	2300	CALL INMUS(K,JJ2,RN(I),PWDS(J),RSTFAC)
30100	    	IF(J2.EQ.0)GO TO 2310
30200	C****2300	IF(J2.EQ.0)GO TO 2310
30300		NAME=L
30400		EXT=X
30500	C ABOVE GETS BACK ORIGINAL NAME WITH 'GM' AND 'Gn'
30600	2310	RSTF=0
30700	C***	CALL EXTIN(RSTFAC,128)
30800	C***	CALL EXTIN(PWDS(J),JJ2)
30900	C***	CALL EXTIN(RN(I),IPOS)
31000		ITEM=ITEM+JJ2-2
31100	CCCC    IF(J2)GO TO 2203
31200		IF(J2)2350,2320,2330
31300	CC      IF(I2.EQ.IM)GO TO 2203
31400	C J2=-1,1=GM *******'GET MORE' DOES NOT GET MOTIVE LIST OF NEW FILE.****
31500	2320	IF(LCNT.GT.1)CALL EXTIN(LIST,LCNT)
31600		I=IPOS
31700		IF(RSTF.EQ.0)GO TO 1320
31800	C  (END OF V ARRAY)RSTF=-1 MEANS READ THE DPY BUFFER
31900		CALL EXTIN(ST,4302)
32000		CALL DPYNEW
32100		GO TO 130
32200	
32300	2330	DO 2340 K=1,ITEM
32400		IF(RN(PWDS(K)+1).NE.8)GO TO 2340
32500		J3=PWDS(K)
32600		IF(RN(J3+2).NE.0)GO TO 2340
32700		R8=RN(J3+8)
32800	C ASSUMES SPACE INFO IS IN P8.  GET IT.
32900	C NEXT FOR VERTICAL SPACING OF NEW STAFF TO BE READ.
33000		R5=23.9/RSTFAC(0)
33100		R3=.73*R2
33200	C INCHES BETWEEN STAVES=.73
33300		R4=(R8-R3)*R5
33400	C R4=CHANGE FROM NORMAL POSITION FOR INCOMING STAFF.
33500		GO TO 2350
33600	2340	CONTINUE
33700	C IF NO STAFF 0 WAS FOUND R4=0
33800		R4=0
33900	2350	M=I-1
34000		DO 2360 K=J,J+JJ2-2
34100		PWDS(K)=PWDS(K)+M
34200		IF(J2.LE.0)GO TO 2360
34300	C NEXT FOR GET-MORE AND PUT ON STAFF #R2
34400		J3=PWDS(K)
34500		RN(J3+2)=R2
34600		IF(RN(J3+1).NE.8)GO TO 2360
34700		RN(J3+4)=R4
34800	C SET HEIGHT OF STAFF - DEPENDANT UPON P8 OF STAFF 0.
34900	CCC     IF(RN(J3).GE.6)RN(J3+8)=0
35000	C ZERO SPACING PARAM IN UPPER STAVES.
35100	2360	CONTINUE
35200		GO TO 1320
35300		M=IX
35400	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
35500	C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
35600	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
35700	C RMOV HAS INCHES FROM P8 OF STAFF 0.
35800	C  R6=1 FOR NO MOVE AT END.  R7=INCHES TO MOVE FOR NEW STAFF 0.
35900	C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
36000	C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE.  THEN
36100	C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
36200	C  MOVES PLOTTER UP IF P5=0.
36300	
36400	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
36500	2370	IF(M.GE.I)GO TO 2390
36600		IF(IGO.EQ.0)GO TO 2380
36700	C USE "Z" TO DO FIXUP WHEN LIST IS SCRAMBLED !?X@!ZQ
36800		IF(M.EQ.PWDS(ITEM+1))GO TO 2380
36900		K=ITEM+1
37000		CALL TYPSTR('   FIXING ITEM ')
37100		CALL TYPINT(K)
37200		CALL TYPCRL
37300		PWDS(K)=M
37400	2380	CALL RUNTHR(M)
37500		IF(EDQ.LE.0)GO TO 1860
37600		GO TO 130
37700	
37800	2390	M=1
37900		IF(PLT.EQ.1)EDQ=-1
38000		PLT=0
38100		GO TO 130
38200	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
38300	
38400	2400	CALL TYPSTR(' MACRO FILE NAME= ')
38500		ACCEPT 190,K
38600		IF(K.EQ.'99')GO TO 130
38700	C TYPE 99 TO BACKUP.
38800		CALL LO2UP(K)
38900		IF(K.EQ.IBLA)K='MACRO'
39000		CALL OFILE(1,K)
39100		CALL TYPSTR(' END MACRO WITH * ')
39200		CALL TYPCRL
39300	2410	ACCEPT 700,INP
39400		IF(I1.EQ.ISTAR)GO TO 2420
39500		WRITE(1,700)INP
39600		GO TO 2410
39700	2420	END FILE 1
39800		CALL TYPSTR(' MACRO=')
39900		CALL TYPWRD(K)
40000		CALL TYPSTR('.DAT  *****  RUN IT? ')
40100		ACCEPT 700,I1
40200		CALL LO2UP(I1)
40300		IF(I1.EQ.LYY)GO TO 220
40400		GO TO 130
40500	
40600	CRR***2430	FORMAT(I,24F)
40700	2430	END